home *** CD-ROM | disk | FTP | other *** search
/ HamCall (October 1991) / HamCall (Whitehall Publishing)(1991).bin / prgming / pastut / amort3.pas < prev    next >
Pascal/Delphi Source File  |  1990-10-14  |  2KB  |  71 lines
  1.                                      (* Chapter 14 - Program 3 *)
  2. program Amortization_Table;
  3.  
  4. var Month : 1..12;
  5.     Starting_Month : 1..12;
  6.     Balance : real;
  7.     Payment : real;
  8.     Interest_Rate : real;
  9.     Annual_Accum_Interest : real;
  10.     Year : integer;
  11.  
  12. procedure Initialize_Data; (* ******************** initialize data *)
  13. begin
  14.    Balance := 2500.0;
  15.    Starting_Month := 5;
  16.    Payment := 100.0;
  17.    Interest_Rate := 0.13/12.0;
  18.    Annual_Accum_Interest := 0.0; (* This is to accumulate Interest *)
  19.    Year := 1985;
  20. end;
  21.  
  22. procedure Print_Annual_Header; (* ************ print annual header *)
  23. begin
  24.    Writeln;
  25.    Writeln('Month    payment  interest    princ   balance');
  26.    Writeln;
  27. end;
  28.  
  29. procedure Calculate_And_Print; (* ************ calculate and print *)
  30. var Interest_Payment : real;
  31.     Principal_Payment : real;
  32. begin
  33.    if Balance > 0.0 then begin
  34.       Interest_Payment := Interest_Rate * Balance;
  35.       Principal_Payment := Payment - Interest_Payment;
  36.       if Principal_Payment > Balance then begin  (* loan payed off *)
  37.          Principal_Payment := Balance;             (* this month *)
  38.          Payment := Principal_Payment + Interest_Payment;
  39.          Balance := 0.0;
  40.       end
  41.       else begin  (* regular monthly payment *)
  42.          Balance := Balance - Principal_Payment;
  43.       end;
  44.       Annual_Accum_Interest := Annual_Accum_Interest+Interest_Payment;
  45.       Writeln(Month:5,Payment:10:2,Interest_Payment:10:2,
  46.               Principal_Payment:10:2,Balance:10:2);
  47.    end; (* of if Balance > 0.0 then *)
  48. end;
  49.  
  50. procedure Print_Annual_Summary; (* ********** print annual summary *)
  51. begin
  52.    Writeln;
  53.    Writeln('Total interest for ',Year:5,' = ',
  54.             Annual_Accum_Interest:10:2);
  55.    Annual_Accum_Interest := 0.0;
  56.    Year := Year + 1;
  57.    Writeln;
  58. end;
  59.  
  60. begin   (* ******************************************* main program *)
  61.    Initialize_Data;
  62.    repeat
  63.       Print_Annual_Header;
  64.       for Month := Starting_Month to 12 do begin
  65.          Calculate_And_Print;
  66.       end;
  67.       Print_Annual_Summary;
  68.       Starting_Month := 1;
  69.    until Balance <= 0.0;
  70. end.  (* of main program *)
  71.